home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / wheels1.arc / FILEATTR.LIB < prev    next >
Text File  |  1985-06-28  |  1KB  |  32 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5.    NOTE that any program that INCLUDEs this file MUST also include the
  6.    type declarations contained in REGPACK.TYP and FILENAME.TYP
  7.  
  8. }
  9. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  10. procedure FileAttribute(activity : char;
  11.                     VAR the_file : filename_type ;
  12.           VAR new_attrib, error  : byte);
  13. var
  14.   registers : regpack;
  15. begin
  16.   the_file[length(the_file)+1] := #0;
  17.   with registers do
  18.     begin
  19.       DS := seg(the_file);
  20.       DX := ofs(the_file)+1;
  21.       AX := ($43 shl 8);
  22.       if UpCase(activity) = 'W' then AX := AX + 1;
  23.       CX := new_attrib;
  24.       MSDOS(registers);
  25.       new_attrib := CX;
  26.       if Flags and 1 = 1 then
  27.         error := AX
  28.       else error := 0;
  29.     end;
  30. end;
  31.  
  32. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}